home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / zebu v3.3.3 (LALR parser) / zebu-g-symbol.lisp < prev    next >
Encoding:
Text File  |  1994-09-12  |  3.7 KB  |  108 lines  |  [TEXT/ttxt]
  1. ; -*- mode:     CL -*- ----------------------------------------------------- ;
  2. ; File:         zebu-g-symbol.l
  3. ; Description:  Conversion to CL of the original Scheme program by (W M Wells)
  4. ; Author:       Joachim H. Laubsch
  5. ; Created:      10-Oct-90
  6. ; Modified:     Thu Apr 29 10:49:59 1993 (Joachim H. Laubsch)
  7. ; Language:     CL
  8. ; Package:      ZEBU
  9. ; Status:       Experimental (Do Not Distribute) 
  10. ; RCS $Header: $
  11. ;
  12. ; (c) Copyright 1990, Hewlett-Packard Company
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; Revisions:
  15. ; RCS $Log: $
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. ;;;             Copyright (C) 1989, by William M. Wells III
  18. ;;;                         All Rights Reserved
  19. ;;;     Permission is granted for unrestricted non-commercial use.
  20.  
  21. (in-package "ZEBU")
  22. ;;; Grammar symbols are represented by g-symbol structs.
  23. ;;;
  24. ;;;
  25. ;;; print-name is a string.  
  26. ;;;
  27. ;;; index is a unique integer associated with the symbol.
  28. ;;;
  29. ;;; own-productions is a list of the productions that the symbol
  30. ;;;                 appears on the left side of.
  31. ;;; rhs-productions is a list of the productions the symbol appears
  32. ;;;                 on the right side of.
  33. ;;;
  34. ;;; first-set is the set of terminal grammar symbols which can
  35. ;;;                 legally start a string derived from the symbol.
  36. ;;;
  37. ;;; first-set-dependers is used in the computation of the first-set.
  38. ;;;
  39. ;;; derives-empty-string is a quick way of telling if the empty
  40. ;;;                 string is in the first-set of the symbol.
  41. ;;;
  42. ;;; follow-set is the set of terminal symbols which may appear after
  43. ;;;                 the symbol in strings of the language.
  44. ;;;
  45. ;;; follow-dependers is the set of grammar symbols whose follow sets
  46. ;;;                 must contain this guys follow set.
  47. ;;; sets will be represented by o-sets.
  48. ;;;
  49. ;;; A hack -- a g-symbol is non-terminal if its own-productions is NOT '().
  50.  
  51. (defstruct (g-symbol (:print-function
  52.               (lambda (g-symbol stream depth)
  53.             (declare (ignore depth))
  54.             (let ((name (g-symbol-name g-symbol)))
  55.               (if (g-symbol-non-terminal? g-symbol)
  56.                   (format stream "[<~A>]" name)
  57.                 (format stream "<~A>" name))))))
  58.   name
  59.   index
  60.   (own-productions     '())
  61.   (rhs-productions     '())
  62.   (first-set           (make-oset :order-fn #'g-symbol-order-function))
  63.   (first-set-dependers (make-oset :order-fn #'g-symbol-order-function))
  64.   (derives-empty-string '())
  65.   (follow-set          (make-oset :order-fn #'g-symbol-order-function))
  66.   (follow-dependers    (make-oset :order-fn #'g-symbol-order-function)))
  67.  
  68.  
  69. (declaim (inline g-symbol-non-terminal?))
  70. (defun g-symbol-non-terminal? (sym)
  71.   (not (null (g-symbol-own-productions sym))))
  72.  
  73. (defmacro new-g-symbol (name index)
  74.   `(make-g-symbol :name       ,name
  75.                   :index      ,index))
  76.  
  77. (declaim (inline g-symbol-order-function))
  78. (defun g-symbol-order-function (sa sb)
  79.   (declare (type g-symbol sa sb))
  80.   (let ((sai (g-symbol-index sa)) (sbi (g-symbol-index sb)))
  81.     (declare (fixnum sai sbi))
  82.     (if (<= sai sbi)
  83.     (if (< sai sbi)
  84.         'correct-order
  85.       'equal)
  86.       'wrong-order)))
  87.  
  88. (declaim (inline g-symbol-add-production))
  89. (defun g-symbol-add-production (g-symbol production)
  90.   (setf (g-symbol-own-productions g-symbol)
  91.     (cons production (g-symbol-own-productions g-symbol))))
  92.  
  93. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  94. ;;; test
  95. #||
  96. (load "g-symbol")
  97. (defvar g1 (new-g-symbol "foo" 3))
  98. (defvar g2 (new-g-symbol "goo" 5))
  99. (g-symbol-order-function g1 g2)
  100. (g-symbol-non-terminal? g1)
  101. (print g1)
  102.  
  103. ||#
  104.  
  105. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  106. ;;                              End of zebu-g-symbol.l
  107. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  108.